perm filename IBMQ.F4[MU5,LCS] blob sn#107304 filedate 1974-06-19 generic text, type T, neo UTF8
C****** SCOR5  FOR PDP10  **********
	BLOCK DATA
 	COMMON /X/ P(30),J,L,CNT(10),BT,MK,VX(35),PL(30),DF,IXIN,NINS,TF,
	1 ROFF(10),V(2000),NP(10),PCH(10,32),INST(11),DUR(11),IALL,
     1DURX,AMPFAC,BNW(40),IT(30),I,OP1,INUM(10),BG(80),INP(72),TP,
	1NWZ,CVTX,ISCA(12),IDAT(11),IQ(25),SCAL(86),MU5(14)
	1,LIST(78),ALL(10,31),NWRITE
C  INST AND DUR MUST HAVE 1 MORE THAN MAX NUM OF INSTS IN ARRAYS!!!
      DATA ISCA/'C','P','D','N','E','F','U','G','S','A','V','B'/
      DATA IDAT/'0','1','2','3','4','5','6','7','8','9','.'/
      DATA MU5/'T','C','2','N','V','R','3','4','X','I','H','M','D','S'/
C  OUT, OSC, AD2, RAN, ENV, STR, AD3, AD4, MLT, SET, RAH.(CONT AND FLT NOT USED.
	DATA V/2000*0/,BT/0/,PL/30*0/,I/1/,NINS/0/,IXIN/1/,TP/0/,NWZ/0/,
	1CNT/10*0/,NP/10*0/,PCH/320*0/,CVTX/10000./,DURX/19999./,PL/30*1./
	1,AMPFAC/1./,TF/1./,IALL/0/,ALL/310*-1/
	DATA SCAL/'C1','CS1','D1','DS1','E1','F1','FS1','G1',
	1 'GS1','A1','AS1','B1','C2','CS2','D2','DS2','E2',
	1 'F2','FS2','G2','GS2','A2','AS2','B2','C3','CS3','D3','DS3',
	1 'E3','F3','FS3','G3','GS3','A3', 'AS3','B3','C4','CS4',
	1 'D4','DS4','E4','F4','FS4','G4','GS4','A4','AS4','B4','C5','CS5'
	1 ,'D5','DS5','E5','F5','FS5','G5','GS5','A5','AS5','B5','C6','CS6'
	1 ,'D6','DS6','E6','F6','FS6','G6','GS6','A6','AS6','B6','C7','CS7'
	1 ,'D7','DS7','E7','F7','FS7','G7','GS7','A7','AS7','B7','R','END'/ 
	END

C   LOAD 'SCORE' WITH RAND.REL (RANDOM NUMBER GENERATOR) AND,
C   IF DESIRED, A SUBROUTINE WITH THE FOLLOWING HEADING:
C	SUBROUTINE SUBR
C	COMMON /X/ P(30),INST,IPAR,CNT(10),BT,IREST,CVT(35),PL(30),DF
C  INST=INST N. IPAR=PARAM N. DF=DUTY FACTOR.  WHEN SUBROUTINE IS CALLED

	COMMON /X/ P(30),J,L,CNT(10),BT,MK,VX(35),PL(30),DF,IXIN,NINS,TF,
	1 ROFF(10),V(2000),NP(10),PCH(10,32),INST(11),DUR(11),IALL,
     1DURX,AMPFAC,BNW(40),IT(30),I,OP1,INUM(10),BG(80),INP(72),TP,
	1NWZ,CVTX,ISCA(12),IDAT(11),IQ(25),SCAL(86),MU5(14)
	1,LIST(78),ALL(10,31),NWRITE
      DATA ICOM/','/,IMIN/'-'/,ISEMI/';'/,DEBUG/0/,PARENS/0/,
	1IBLA/' '/,KSLA/'/'/,JZ/0/,KL/0/,RA/0/,
	1BY/-1./,LPAR/0/,ITMPO/'TEMP'/,IRUN2/'RUN;'/,IRUN/'RUN'/,KZY/10/
	1,IDALL/0/,ISTAR/'*'/,ILFP/'('/,IAT/'@'/,IPLUS/'+'/,LCNT/1/
	1,RETRO/-1./,INVRT/-1/,IRTP/')'/,IEL/'L'/,IDOL/'$'/
	EQUIVALENCE (V2,V(2)),(V3,V(3)),(V4,V(4)),(VX2,VX(2)),(VX1,VX(1))
	1,(IPP,ISCA(2)),(VX3,VX(3)),(V5,V(5)),(IEN,ISCA(4)),(IE,ISCA(5))
	1,(VX4,VX(4)),(VX5,VX(5)),(VX6,VX(6)),(IU,ISCA(7)),(ITT,MU5(1))
	1,(ISS,ISCA(9)),(IV,ISCA(11)),(ID,ISCA(3)),(IF,ISCA(6)),(IDOT,
	1IDAT(11)),(IEM,MU5(12)),(II,MU5(10)),(IR,MU5(6)),(IXX,MU5(9))
	1,(IG,ISCA(8)),(IAA,ISCA(10))
C IF DIMENSIONS ARE CHANGED, CHANGE KZY. ALL CHANGES MUST BE MULTIPLES OF KZY.
C SET INST(KZY+1), CHECK BG, CHECK BLOCK DATA VALUES.
	TYPE 3773
3773	FORMAT(' TYPE'/)
	ACCEPT 2107,IBM
2107	FORMAT(A5)
	IF(IBM.EQ.IBLA)IBM='ILIST'
	NWRITE=21
	REWIND NWRITE
C  21=DSK1 ON PDP10.  'REWIND' RESETS IT.

	DO 1900 K=1,10
1900	INUM(K)=K
	CALL IFILE(1,IBM)
	CALL ZERPP
	NDEC=1
C   SET NDEC TO 5 FOR IBM.
3000	FORMAT(1X72A1)
	JMP=1
8002	JA=-1
	ICT=0
	IF(JZ.EQ.-1)GO TO 1773
8001	READ(NDEC,5900)KW,INP
C   REMOVE KW ETC. FOR IBM.
7006	PRINT 3000,INP

	IF(INP(1).EQ.IBLA)GO TO 8001
C   BLANK LINES MAY APPEAR IN INSTS.
	MLX=1
	GO TO 1773
101	ISUB=5
	IZ=15
	N=INP(ML+2)
	DO 2900 K=1,14
2900	IF(N.EQ.MU5(K))IZ=K
	IF(IZ.NE.1)GO TO 3900
	IF(INP(ML).EQ.IEM)IZ=9
	IF(INP(ML).EQ.ISS)IZ=10
	IF(INP(ML+1).EQ.IR)IZ=12
	GO TO 4900
3900	IF(INP(ML).NE.IG)GO TO 4900
	ISUB=6
	GO TO 2899
4900	IF(IZ.LE.11)GO TO 9015
	IZ=IZ-11
	GO TO (9018,9014,6900,1129),IZ
C             SRT   END  INS  SCORE
C  ABOVE FOR UNIT GENERATORS
6900	Y=36.
	ISUB=12
	GO TO 2899
12	V2=2.
	V3=VX1
	V4=VX2
	L=4
	GO TO 72
5	L=JJ+4
	DO 9021 K=5,L
9021	V(K)=VX(K-4)
	GO TO(72,172,72,172,172,72,72,72,72,72,172,72,72),IZ
172	NL=1
	IF(IZ.EQ.4)NL=3
	IF(IZ.EQ.11)NL=2
	DO 472 K=1,NL
	Y=Y-1.
	L=L+1
472	V(L)=Y
	IF(IZ.EQ.2)L=9
C  ABOVE ALLOWS A 'V' TO BE PUT AT END OF OSC.
72	M=L-1
 	WRITE(NWRITE)M,(V(K),K=2,L)
6006	PRINT 5552,M,(V(K),K=2,L)
	IF(LPAR)2129,8002,8002
5552	FORMAT(I3,(14F9.2))
9014	L=3
	GO TO 72
6	L=JJ+ICT+2
	V2=3.
	NL=3
	IF(JA.NE.-9998)GO TO 8006
	NL=ICT+1
	L=L-2
8006	DO 9022 K=NL,L
9022	V(K)=VX(K-NL+1)
	IF(IAMP.LT.0)GO TO 72
	READ(1,5900)K,INP
	PRINT 3000,INP
	IAMP=0
	DO 90221 K=1,72
	N=INP(K)
	IF(N.NE.ISTAR)GO TO 90221
	IAMP=-1
	GO TO 90222
90221	IF(N.EQ.ISEMI)GO TO 90222

90222	ML=1
	JA=-9998
	ICT=ICT+L
	GO TO 1899
9015	JA=0
C   L+100=MACH.LANG. UNIT GENS. L=FORTR. UNIT GENS.
	V4=IZ+100
	IF(IZ.EQ.6)LPAR=1
	GO TO 2899
9018	ISUB=8
	V4=4.
	GO TO 2899
8	V5=VX1
	V2=11.
	L=5
	CVTX=V5
	GO TO 72
1129	IF(LPAR)2129,2129,222
222	L=5
	V2=12.
	V4=8.
	V5=1.
	LPAR=-1
	GO TO 72
2129	ISUB=7
	LPAR=0
	DO 107 K=1,6
107	VX(K)=0
	ML=ML+5
	GO TO 1899
7	IF(VX1.NE.0)IXIN=VX1
	IF(VX2.NE.0)TF=VX2
	IF(VX3.NE.0)AMPFAC=VX3
	OP1=VX4
	IF(VX5.NE.0)DURX=VX5
5900	FORMAT(I,72A1)
1107	FORMAT(I,A4,72A1)
	CALL RNDINT
C  IAMP IS 'BLANK LINE'FLAG ON {PP1-3.
	DEBUG=VX6
C  TYPE 'SCORE', TF=TEMPO FACTOR(0=1), AMPFAC=AMPL.FACT(0=1), OP1=SECONDS TO BE OMITTED, 
C  DURX=DUR AT CUTOFF, DEBUG>0 PRINTS 'V' ARRAY.

C   *************** READS INPUT  ***********************
2308	READ(1,1107)L,J,INP
	IF(J.EQ.IBLA)GO TO 2308

	MLX=1
	JA=-1
		ISUB=9
		JMP=5
	VX1=0
	VX2=0
	VX3=0
	LK=-1
	K=0
	IF(V(I-1).NE.-9900.-BY)GO TO 6773
	BY=-1.
	I=I-1
C********* FEB 15,71
6773	K=K+1
	IF(K.GT.NINS)GO TO 36
	IF(INST(K).NE.J)GO TO 6773
	LK=K
	GO TO 1773
36	IF(J.EQ.IRUN.OR.J.EQ.IRUN2)GO TO 4337
	IF(J.EQ.ITMPO)GO TO 1773
	LK=NINS+1
	IF(LK.GT.KZY)CALL EXIT
	INST(LK)=J
	IZ=LK
C******* MAY 3,71
	GO TO 1773
4337	IF(V(I-1).EQ.-9900.-BY)I=I-1
	V(I)=-19899.
	IF(DEBUG.NE.0)CALL RUNIT
	N=1
5002	K=N+1
	IF(N.GT.I)CALL RUNIT
	IF(V(N).GE.0)GO TO 1002
	PRINT 4002,V(N)
	N=N+1
	GO TO 5002
1002	J=V(K)+K-1
CC	IF(J.LT.N)J=N
CC	IF(N.GT.J)CALL RUNIT
	PRINT 4002,(V(K),K=N,J)
	N=J+1
	GO TO 5002
CC	CALL RUNIT
4002  FORMAT(10F12.3)
9	IF(LK.LE.NINS)GO TO 8773
	IF(IALL.EQ.0)GO TO 1004
	IF(IDALL.GT.0)GO TO 8773
	BG(LK)=VX1
	IDALL=LK
	GO TO 2004
1004	BG(LK)=VX1
C MAY 3,71 **** ALL PARAMS WILL BE SET UP AT TIME 0. CHECK EFFECT ON 'MOVE'!
C ******** APR.23, 1971  FIXES BG TIMES IN 'MOVE'?????!!!!!!!
	IF(LK.EQ.IZ)VX1=0
2004	NINS=LK
	IF(VX3.NE.0)VX2=10000.+VX3
	IF(VX2.EQ.0)VX2=-1
	DUR(LK)=VX2
	GO TO 900
8773	IF(VX2.NE.0)VX1=VX1*10000.+VX2
900	IF(VX1.EQ.BY)GO TO 5773
	BY=VX1
	K=V(I-1)/(-9900.)
	IF(K.GE.1.AND.K.LE.NINS)I=I-1
	V(I)=-9900.-BY
	I=I+1
	IF(NWZ.EQ.0)GO TO 4308
	DO 9703 K=1,NWZ
9703	IF(BY.EQ.BNW(K))GO TO 5773
4308	NWZ=NWZ+1
	BNW(NWZ)=BY
5773	IF(J.EQ.ITMPO)GO TO 1106
4773	NW=LPAR
	JMP=2
1299	IF(JZ.NE.0)GO TO 1773
7773	READ(1,5900)L,INP

	IF(INP(1).EQ.IBLA)GO TO 7773
	MLX=1
C   'LISTS' END WITH  *
1773	JZ=0
	IALL=0
17731	ML=MLX
	DO 236 JD=ML,72
	JF=INP(JD)
C """""""""" MAY 13,71 /Z(D4/E/X 2 3/)CS/ ETC.  CAN USE 26 LABELS.
33611	IF(JF.NE.ILFP.AND.JF.NE.IRTP)GO TO 2361
	INP(JD)=IBLA
	L=JD-1
1113	IF(INP(L).NE.IBLA)GO TO 2113
	L=L-1
	GO TO 1113
2113	IF(JF.EQ.IRTP)GO TO 3361
	IF(PARENS.EQ.0)GO TO 1140
	LCNT=LCNT+3
	MOT=LCNT-1
1140	LIST(LCNT)=INP(L)
	PARENS=-1.
	INP(L)=IBLA
C  ALLOWS FOR SPACE AFTER IDENTIFIER
	LIST(LCNT+1)=I
	GO TO 236
3361	IF(PARENS.EQ.0)GO TO 2140
	LIST(LCNT+2)=I-1+IAMP
C  +IAMP IS TO ADD SPACE FOR CVT IN V ARRAY.
	LCNT=LCNT+3
	PARENS=0
	GO TO 236
2140	LIST(MOT)=I-1+IAMP
	GO TO 236
C """""""""""  LAST ) CAN'T APPEAR AT END OF LINE!!
C @@@@@@@@@@@@ /@Z/DS3/ ETC. 
2361	IF(JF.NE.IAT)GO TO 5361
	DO 113 L=1,72
	K=JD+L
	JG=INP(K)
	IF(JG.NE.IMIN)GO TO 6113
	RETRO=0
      INP(K)=IBLA
	GO TO 113
6113	IF(JG.NE.IDOL)GO TO 7113
C  IDOL IS FOR INVERSIONS IN 'NOTES'
	INVRT=0
	GO TO 113
7113	IF(JG.NE.IBLA)GO TO 4113
113	CONTINUE
4113	DO 6361 L=1,LCNT,3
	IF(JG.NE.LIST(L))GO TO 6361
	VX1=0
	DO 40 M=JD+2,72
	JG=INP(M)
	IF(JG.EQ.IBLA)GO TO 40
	ML=M
	IF(JG.EQ.KSLA.OR.JG.EQ.ISEMI.OR.JG.EQ.ISTAR)GO TO 140
	GO TO 240
40	CONTINUE
240	JC=JA
	JA=-1
	ICT=ISUB
	ISUB=15
	INP(K)=IBLA
	GO TO 1899
15	ISUB=ICT
	JA=JC
140	JC=1
	KN=LIST(L+1)
	M=LIST(L+2)+1
	IF(RETRO)GO TO 640
	JC=M-1
	M=KN-1
	KN=JC
	JC=-1
	RETRO=-1.
640	IF(INVRT)GO TO 940
840	X=V(KN)
	V(I)=X+VX1
C  FINDS CENTER FOR INVERSION (+TRANSP.)
	I=I+1
	KN=KN+JC
	IF(V(KN-JC).NE.85.)GO TO 940
	V(I-1)=85.
	GO TO 840

940	Z=V(KN)
	IF(INVRT.EQ.0)GO TO 440
	IF(VX1.EQ.0)GO TO 540
C  " @Q N " WHERE N= 1/2 STEPS IN 'NOTES' OR MULT FACTOR IN OTHERS.
	IF(CODE.EQ.-33.)GO TO 440
	V(I)=Z*VX1
	GO TO 7361
440	IF(Z.EQ.85.)GO TO 540
	Y=0
	IF(INVRT.EQ.0)Y=(X-Z)*2.
	V(I)=Z+VX1+Y
	GO TO 7361
540	V(I)=Z
7361	I=I+1
	KN=KN+JC
	IF(KN.NE.M)GO TO 940

	INVRT=-1
	RB=V(I-1)
	ICT=-1
	DO 8361 L=JD,72
	JG=INP(L)
	INP(L)=IBLA
	IF(JG.EQ.KSLA)GO TO 9361
	IF(JG.EQ.ISEMI)GO TO 2722
8361	IF(JG.EQ.ISTAR)ICT=0
9361	MLX=L+1
	IF(ICT.LT.0)GO TO 17731
	JZ=-1
2722	IF(ICT.LT.0)GO TO 7773
	IAMP=-1
	GO TO 3013
6361	CONTINUE
	CALL EXIT
C @@@@@@@@@@@@@@@@@@@@@@@@@@
5361	IF(JF.NE.IAA)GO TO 4361
C   FINDS 'ALL'.
	IF(INP(JD+1).NE.IEL)GO TO 236
	INP(JD)=IBLA
	INP(JD+1)=IBLA
	INP(JD+2)=IBLA
	IALL=-1
	GO TO 236
C  TYPE 'ALL' AFTER PARAM NUM TO PUT DATA IN ALL INSTS.
4361	IF(JF.NE.KSLA)GO TO 636
	MLX=JD+1
	JZ=-1
	INP(JD)=ISEMI
436	IF(INP(MLX).NE.IBLA)GO TO 336
	MLX=MLX+1
	GO TO 436
636	IF(JF.NE.ISEMI)GO TO 936
336	IF(JMP.GT.4)GO TO 1899
   	GO TO (101,102,103,104),JMP 
C            INST PAR  MOV  LIST OTHERS
936	IF(JF.NE.IDOT)GO TO 736
	IF(CODE.NE.-22.)GO TO 236
	L=INP(JD+1)
	DO 836 KL=1,10
836	IF(L.EQ.IDAT(KL))GO TO 236
	INP(JD)=1
	GO TO 236
C   CHANGES DOTTED RHYTHMS TO '1'S.
736	IF(JF.NE.ISTAR)GO TO 236
	IAMP=-1
	INP(JD)=ISEMI
236	CONTINUE
	CALL EXIT
C   IF ERROR - THEN EXIT.

102	NX=INP(ML)
	IZ=ML
	ML=ML+1
	ISUB=13
	IF(NX.EQ.IBLA)GO TO 102
	JA=-1
	IF(NX.EQ.IPP)GO TO 1899
	IF(NX.EQ.IE)GO TO 2308
	IF(NX.EQ.IR)GO TO 4337
	IF(NX.EQ.ID)GO TO 7720
	IF(NX.EQ.II)GO TO 1899
	CALL EXIT
13	LPAR=VX1
	IF(NX.NE.II)GO TO 136
	INUM(LK)=LPAR
	GO TO 1299
136	IAMP=0
	IF(IALL.LT.0)ALL(LK,LPAR)=0
	CVT=0
	IF(LPAR.EQ.2)CVT=1.
	IF(LPAR.GT.NP(LK).AND.LPAR.LT.31)NP(LK)=LPAR
	IF(LPAR.EQ.32)LPAR=1
	V(I)=LPAR+LK*10000
C  +1=WDCNT, +2=CODE, +3='NM' CCCCC
	IJ=I+1
	I=I+4
	ITMP=0
	CODE=0
	NFLG=1
	ML=IZ+M
C  M IS NUM. OF DIGITS IN PARAM NUM.
5702	ML=ML+1
	IF(ML.GT.72)CALL EXIT
	N=INP(ML)
	IF(N.EQ.IBLA)GO TO 5702
	NL=INP(ML+1)
	JA=0
	IF(N.EQ.IR)GO TO 6702
	IF(N.EQ.IEN)GO TO 6005
	IF(N.EQ.IEM.OR.N.EQ.ISS)GO TO 2007
	IF(N.EQ.ID.AND.NL.EQ.IF)GO TO 7702
	IF(N.EQ.ISEMI)GO TO 2018
	IF(N.EQ.IPP)JA=-1
	ISUB=1
	GO TO 1899
C   RE=REP  R=RHY  M=MOVE  N=NOTES  NU=NUM  S=SUBR

6702	JA=-1
	IF(NL.EQ.IE)GO TO 2703
	CODE=-22.
	CVT=1.
C   P2 AND 'RHY' ALWAYS CONVERT AS 'DUR'.
	GO TO 1016
6005	CODE=-33.
	IF(NL.EQ.IU)GO TO 9702
	CVT=-1.
	GO TO 1016
9702	CODE=-44.
	JA=-1
2007	NL=ML+2
	DO 1007 KN=NL,72
	JJ=INP(KN)
	IF(JJ.EQ.IF)CVT=-1.
	IF(JJ.EQ.ID)CVT=1.
1007	IF(JJ.EQ.ISEMI)GO TO 3007
3007	IF(N.EQ.ISS)GO TO 5007
	IF(N.NE.IEM)GO TO 1016
4007	BW=V(IJ-2)
	IC=0
	DO 7031 K=ML+1,72
	IF(INP(K).EQ.ISEMI)GO TO 8031
7031	IF(INP(K).EQ.IXX)IC=-1
C****************  JUNE 1,71   X 4
8031	I=I-1
	V(I)=0
	X=-9900.-BY
	IF(BY.EQ.0)X=-9900.-BG(LK)
	IF(BW.EQ.X)GO TO 8005
	IF(BW.NE.-9900.-BY)GO TO 1102
	V(IJ-2)=X
	GO TO 8005
1102	V(IJ)=V(IJ-1)
C   IF BG>0, 'MOVE' POINTERS ARE NOT SET UP AT TIME 0.
	V(IJ-1)=X
	IJ=IJ+1
	I=I+1
8005	LP=IJ-1
	BW=-(X+9900.)
	ISUB=2
	JMP=3
	IZ=-1
4703	GO TO 1299
103	IF(IZ.LT.0)GO TO 2102
	BW=V(ICT)+BW
	V(I)=-9900.-BW
	V(I+1)=V(LP)
	V(I+2)=JJ+3
	V(I+3)=CODE
	I=I+4
	IZ=1
2102	IF(BW.GT.10000.)GO TO 6308
	DO 5308 K=1,NWZ
5308	IF(BW.EQ.BNW(K))GO TO 6308
	NWZ=NWZ+1
	BNW(NWZ)=BW
6308	VX3=-9900.
	VX2=VX3
	GO TO 1899
2	IF(VX3.NE.-9900.)GO TO 3102
	IF(VX2.NE.-9900.)GO TO 4102
	VX2=VX1
	VX1=10000.
4102	VX3=VX2
	JJ=3
C  1,2 OR 3 NUMS CAN BE USED IN NON-RAN MOVES.
3102	IF(IZ.GE.0)GO TO 3006
	V(IJ)=JJ+3
	CODE=-55.
	IF(JJ.NE.3)CODE=-57.
	IF(NFLG.LT.0)CODE=CODE-1.
	IF(IC.LT.0)CODE=-59.
C****************  JUNE 1,71   
	V(IJ+1)=CODE
C   -10000. MEANS 'NOTES AT BG TIME 0'
C  CODE=-56 OR -58 FOR NOTES.
C**********************↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑
	IZ=0
3006	IF(NFLG.EQ.1)GO TO 5005
	CVT=-1
	IF(VX2.GT.VX3)VX2=VX2+.999
	IF(VX3.GE.VX2)VX3=VX3+.999
	IF(JJ.EQ.3)GO TO 5005
	IF(VX4.GT.VX5)VX4=VX4+.999
	IF(VX5.GE.VX4)VX5=VX5+.999
C   FOR RAN. SELEC. OF NOTES.  FINDS HIGHEST NOTE.
5005	ICT=I
	IJ=IJ+1
	DO 1006 K=1,JJ
1006	V(IJ+K)=VX(K)
	I=I+JJ
	V(I)=CVT
	I=I+1
	IJ=I+2
	IF(IAMP.EQ.0)GO TO 1299
C*************** MAY 18,71 ***** ALWAYS RESETS TO TIME 0 WHEN MOVE IS USED.
	V(I)=-9900.-BY
8703	I=I+1
C   PUT A ZERO IN CVT SLOT.
	GO TO 4773
5007	V(IJ)=3.
	V(IJ+1)=-11.
	V(I-1)=CVT
	GO TO 4773
7702	CODE=-45
	JA=-1
	GO TO 1016
C  ABOVE FOR DUTY FACTOR

1	I=I+JJ
	ISUB=0
	V(IJ+1)=NNUM
	IF(NNUM.EQ.-2)CVT=-1.
	IF(JJ.EQ.1)GO TO 4006
C  IF IT IS '-2' THEN NOTES ARE PRINTED
	IF(NNUM.NE.-2)GO TO 5006
	IX=IJ+3
	DO 2006 K=2,JJ,3
	X=VX(K)  
	Y=VX(K+1)  
	IF(X.GT.Y)VX(K)=X+.999
2006	IF(Y.GE.X)VX(K+1)=Y+.999
5006	IX=IJ+2
	DO 1001 K=1,JJ
1001	V(IX+K)=VX(K)
C   FOR RAN. SELEC. OF NOTES.  FINDS HIGHEST NOTE.
	GO TO 3013
4006	IF(JA.LT.0)VX1=VX1/100.+9999.
C  CHANGES /P5 P3/ TO /P5 9999.03/
	V(I-1)=VX1
	GO TO 3013
2703	ISUB=4
C  'REP'
	VX1=0
	VX2=0
	VX3=0
	ML=ML+1
	GO TO 1899
4	V(IJ)=3.
	V(IJ+1)=-66.0
	IF(VX1.EQ.32.)VX1=1.
	IF(VX1.EQ.0)VX1=LPAR
	IF(VX2.EQ.0)VX2=LK-1
	V(IJ+2)=VX1+VX2*10000.
	KL=VX2
	IF(DUR(LK).LT.0)DUR(LK)=DUR(KL)
	IF(VX3.EQ.0.OR.LK.EQ.NINS)GO TO 4773
18	ML=LK+1
	DO 1018 KL=ML,NINS
	IF(LPAR.GT.NP(KL).AND.LPAR.LT.31)NP(KL)=LPAR
	V(I)=V(I-4)+10000.
	V(I+1)=3.
	V(I+2)=-66.
	V(I+3)=V(I-1)
	IF(DUR(KL).LT.0)DUR(KL)=DUR(LK)
1018	I=I+4
	GO TO 4773
2018	V(IJ)=3.
	V(IJ+1)=-66.
	V(IJ+2)=NW+LK*10000
	GO TO 4773
7720	V(I)=LK
	V(I+1)=3.
	V(I+2)=-67.
	ML=ML+4
	ISUB=14
	GO TO 1899
14	V(I+3)=VX1
	I=I+4
	L=VX1
	IF(NP(LK).LT.NP(L))NP(LK)=NP(L)
	IF(DUR(LK).LT.0)DUR(LK)=DUR(L)
	GO TO 4773
C   TYPE 'DUPL N;'   N=INST # TO BE DUPLICATED.

C ***** SCANNER *************************  
2899	ML=ML+3
1899	IF(INP(ML).EQ.ISEMI.AND.ISUB.EQ.3)GO TO 1014
      NNUM=-1     
      NL=0  
      ISKP=0
      JJ=0  
      XMINUS=1.    
999      IDECI=-1  
	IF(ISUB.EQ.6)XMINUS=1.
C   ABOVE FOR READING MINUS AND PLUS NUMBS. IN GEN CARDS.
      M=0   
2799	N=INP(ML)
899      ML=ML+1
	IF(N.EQ.ISEMI)GO TO 751
C*********************************
	IF(N.NE.IBLA.AND.N.NE.ICOM)GO TO 510
4702      IF(ISKP)202,2799,2799

510	IF(JA.LT.0)GO TO 70
      DO 77 K=1,12   
      IF(N.NE.ISCA(K))GO TO 77
	IF(K.NE.2.AND.K.NE.4)GO TO 511
	IF(ISUB.EQ.5)GO TO 511
	NSWCH=K-4
	GO TO 2799
C  TO SWITCH ALWAYS USE OCT.#  /PBF4/  /NE5/  P=PROXIMITY, N=NORMAL
511   NNUM=K
	NFLG=-1
	N=INP(ML)
	IF(N.NE.IF)GO TO 6410
	NNUM=NNUM-1
	GO TO 7410
6410	IF(N.NE.ISS)GO TO 8410
	NNUM=NNUM+1
7410	ML=ML+1
	N=INP(ML)
	GO TO 3410
C*********************
8410	IF(N.NE.IU.AND.N.NE.IR)GO TO 3410
	NNUM=-1
	CVT=1.
	IF(N.EQ.IR)CVT=-1.
	GO TO 5551
3410	ML=ML+1
	JJ=JJ+1
	IF(ISUB.EQ.5)GO TO 1410
	IF(N.NE.IEN)GO TO 371
C*****************************
	VX(JJ)=86.
	IF(DUR(LK))DUR(LK)=1000.
	IAMP=-1
	GO TO 5551
371	IF(N.EQ.ISEMI.OR.N.EQ.IBLA)GO TO 9410
	DO 177 KN=2,8
	IF(N.NE.IDAT(KN))GO TO 177
	JSCA=KN-2
	GO TO 2410
177	CONTINUE
	GO TO 1411
9410	KN=-1
1411	IF(NSWCH.EQ.0)GO TO 2410
	IF(KN)GO TO 2411
	IF(N.EQ.IPLUS)NOLD=NOLD+6
	IF(N.EQ.IMIN)NOLD=NOLD-6
C /B/B-/ JUMPS DOWN OCT., /B/B+/ UP OCT.
2411	IF(NOLD-NNUM.GT.5.AND.JSCA.LT.7)JSCA=JSCA+1
	IF(NOLD-NNUM.LT.-5.AND.JSCA.GT.0)JSCA=JSCA-1
C   WILL JUMP TO NEAREST NOTE ***********  MAY 22,71
2410	VX(JJ)=JSCA*12+NNUM
	NOLD=NNUM
4410	NNUM=-2
	IF(INP(ML).EQ.ISEMI)GO TO 5551
	GO TO 310
C   OCTAVE NUM WILL STICK UNTIL RESET
77    CONTINUE    
C   ABOVE FINDS SCALE NOTES   
70    IF(N.NE.IMIN)GO TO 71   
      XMINUS=-1    
      GO TO 2799   
210	JJ=JJ+1
	IF(JJ.EQ.1)GO TO 3310
C************************
	XMINUS=1.
	VX(JJ)=0
C***************  	IF(JJ.EQ.1)VX(JJ)=-99.
C   'X N1,N2' MAY REPLACE 'REP N1,N2'. IF N2=0 THEN N2=2
	GO TO 310
71	IF(N.EQ.IXX)GO TO 210
	IF(N.EQ.IR)GO TO 73     

1410  DO 78 K=1,11
      IF(N.NE.IDAT(K))GO TO 78
	ISKP=-1
	IF(N.NE.IDOT)GO TO 79
	IDECI=M
	GO TO 75
79    M=M+1 
      IQ(M)=K-1   
	GO TO 75
78	CONTINUE
	IF(N.EQ.KSLA)N=ISEMI

75	IF(ML.GT.73)CALL EXIT
CC  WHY THE NEXT CHANGE? FOR DOTS MAYBE.  IF(N.NE.ISEMI)GO TO 2799
	IF(N.NE.ISEMI.AND.INP(ML).NE.1)GO TO 2799
751	IF(ISKP.EQ.0)GO TO 5551
C*********************
202	IF(ISUB.EQ.5)GO TO 502
	IF(IDECI.NE.-1)GO TO 302    
      IDECI=0     
      GO TO 402   
302   IDECI=M-IDECI     
402   NN=0  
      IEXP=M-1    
      IF(M.LT.1)M=1     
      DO 171 K=1,M
	KN=10**IEXP
C  BECAUSE '**0' DOES NOT WORK!!
	IF(IEXP.EQ.0)KN=1
      NN=NN+IQ(K)*KN
171     IEXP=IEXP-1     
      A=10**IDECI 
C  BECAUSE '**0' DOES NOT WORK!!
	IF(IDECI.EQ.0)A=1.
	JJ=JJ+1
	VX(JJ)=NN/A*XMINUS
	IF(ISUB.EQ.13)GO TO 13
	IF(CODE.NE.-22.)XMINUS=1.
C  ONLY ONE MINUS NEEDED FOR 'TIED' RESTS IN 'RHY'.
1310	IF(INP(ML).NE.1)GO TO 310
C   FOR DOTTED NOTES.
	VX(JJ+1)=VX(JJ)*2.
	JJ=JJ+1
	ML=ML+1
	GO TO 1310
206	ML=ML+2     
3310  VX(JJ)=-99. 
C******************* X 2
310      ISKP=0
        IF(N.NE.ISEMI)GO TO 999

5551    GO TO(1,2,3,4,5,6,7,8,9,9,11,12,13,14,15),ISUB

502	JD=IQ(1)
	IF(M.GT.1)JD=JD*10+IQ(2)
C   NUMBERS UP TO 2 DIGITS ONLY
C  PARAMETERS WILL PRINT +2 FOR PASS3. USE P2-30 ONLY. WILL PRINT P4-32.
C  USE P33-35 FOR STORAGE IN UNIT GENS.
	IF(NNUM.EQ.11)NNUM=100
	IF(NNUM.EQ.6)NNUM=-(100+2*JD)
	IF(NNUM.EQ.12)NNUM=-(2*JD)
C  ABOVE IS TAKEN CARE OF AT 510+5
	VX(JJ)=JD+NNUM
C   IQ=OCTAVE N., NNUM=NOTE N.
	NNUM=-1
      GO TO 310   
73	JJ=JJ+1
      IF(INP(ML).EQ.IE)GO TO 206    
C   NEXT IS FOR A REST ('R')  
      VX(JJ)=85.
	GO TO 4410
      GO TO 310   

1106	KTMP=1
	TP=60.
	IAMP=0
	BW=BY
	ITMP=-1
	JMP=5
	ISUB=11
	JA=-1
	GO TO 2016
3019	V(I)=990000.00
	V(I+1)=4.
	V(I+2)=VX1
	V(I+3)=VX2/TP
	V(I+4)=VX3/TP
	I=I+5
	BY=BW
	IF(VX1.EQ.0)GO TO 2308
	BW=BW+VX1
	V(I)=-9900.-BW
	I=I+1
	DO 3003 K=1,NWZ
3003	IF(BW.EQ.BNW(K))GO TO 9003
	NWZ=NWZ+1
	BNW(NWZ)=BW
9003	IF(IAMP)GO TO 4003
2016	VX3=0
	VX2=0
	GO TO 1299

11	IF(VX2.NE.0)GO TO 111
	VX2=VX1
	VX1=0
111	IF(VX3.EQ.0)VX3=VX2
	IF(VX2.LT.11.)TP=1.
	IF(J.EQ.ITMPO)GO TO 3019
  	PCH(1,KTMP)=VX1
	PCH(2,KTMP)=VX2
	PCH(3,KTMP)=VX3
C   PCH(1)=TIME  (2)=MM1  (3)=MM2
	KTMP=KTMP+1
	IF(IAMP.EQ.0)GO TO 2016
4003	VX1=0
	IAMP=0
	VX2=VX3
	IF(J.EQ.ITMPO)GO TO 3019
	PCH(1,KTMP)=0
	PCH(2,KTMP)=VX2
	PCH(3,KTMP)=VX2
C   UP TO 30 ITMPO CHANGES MAY BE MADE.   


1016      IA=I    
      IZ=1  
3100	V(I-2)=CODE
      ISUB=3     
	JMP=4
	KZ=0
5016	IF(IAMP.GE.0)GO TO 1299
117	IF(IZ-2)3013,9004,9004
104	K=INP(ML)
	IF(K.EQ.ITT)GO TO 1106
	IF(K.EQ.ISEMI)GO TO 1014
	IF(K.NE.IBLA) GO TO 1899
	ML=ML+1
	GO TO 104
3      IF(VX1.EQ.-99.)GO TO 4022
	IF(CODE.LT.-22.)GO TO 17
2017  VX1=4./VX1
	IF(JJ.NE.1)GO TO 2014
	V(I)=VX1
	GO TO 114
2014	DO 9006 L=2,JJ
	IF(VX(L).EQ.0)GO TO 17
9006	VX1=4./VX(L)+VX1
	JJ=1
17	V(I)=VX1
	IF(JJ.EQ.1)GO TO 114
	L=VX(JJ)-1
	X=V(I)
	NL=I+1
	I=L+I
	DO 1017 K=NL,I
1017	V(K)=X
C   ADDS UP TOTAL   OF NOTES IN SEQ.
	IZ=IZ+L
	GO TO 114
1014	V(I)=RB
114      RB=V(I)     
      I=I+1 
      IZ=IZ+1     
      GO TO 5016    
4022      JC=VX2+.3
      JD=VX3-.9
	IF(JJ.EQ.2)JD=1
      IZ=IZ+JC*JD 
C   JC=HOW MANY TIMES,  JD=HOW MANY NOTES 
      DO 1005 K=1,JD    
       NL=I+JC-1  
      DO 2005 L=I,NL    
2005      V(L)=V(L-JC)
1005      I=I+JC  
	RB=V(NL)
      GO TO 5016  

9004	IF(ITMP.EQ.0)GO TO 3013

      KA=1  
      IC=1  
      K=0   
      Z=0   
      RC=0  
9007      Y=PCH(3,IC)/TP  
      X=PCH(2,IC)/TP  
      Z=PCH(1,IC) 
	YY=2.*Z/(Y+X)
224	IF(YY.NE.0)YY=2.*(Z-X*YY)/YY**2
	RAX=X
      Z=PCH(1,IC) 
      XA=RA 
      RD=1  
      RB=0  
      ZZ=Z  
7020      RA=V(IA+K)    
4020  RD=1  
      IF(RA.LT.0)RD=-1. 
      RA=RA*RD    
      IF(KA.EQ.0)RA=RA-RC     
      W=RA  
      RB=W  
      IF(W.LE.Z)GO TO 2020    
      IF(Z.NE.0)GO TO 3020    
      RA=RA/Y     
      RB=-1.
      RC=0  
      GO TO 8020  
3020      W=Z     
      RC=W+RC     
      GO TO 24    
2020      RC=0    
24	IF(X.NE.Y)GO TO 424
	RA=W/X
	GO TO 8020
C  DUR OF TMP + BG TIME OF TMP - NOTE VALUE - BG TIME OF NOTE
C  CHN=TBG.
424	RA=(-2.*RAX+(4.*RAX**2+8.*YY*W)**.5)/(2.*YY)
	RAX=RAX+YY*RA
8020      IF(KA.EQ.0)RA=RA+XA 
      KA=1  
      IF(RC.NE.0)GO TO 1011   
      V(IA+K)=RA*RD     
      IF(K.EQ.IZ)GO TO 3013     
1011      K=K+1 
      IF(ZZ.NE.0)Z=Z-W  
      IF(Z.GT.0.OR.RB.EQ.-1.)GO TO 7020     

      IC=IC+1     
      IF(RB.EQ.W)GO TO 9007
      KA=0  
      K=K-1 
      GO TO 9007     

3013	V(I)=CVT
	I=I+1
	L=I-IJ
	V(IJ+2)=L-4
	V(IJ)=L
	GO TO 4773

	END